home *** CD-ROM | disk | FTP | other *** search
- /* errmem.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /* Common Block Declarations */
-
- struct {
- doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
- sfactr;
- integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
- itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
- } status_;
-
- #define status_1 status_
-
- struct {
- doublereal cpyknt;
- integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk,
- loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8,
- nwd16;
- } memmgr_;
-
- #define memmgr_1 memmgr_
-
- /* Table of constant values */
-
- static integer c__1 = 1;
-
- /*< subroutine errmem(inam,ierror,ipntr) >*/
- /* Subroutine */ int errmem_(inam, ierror, ipntr)
- integer *inam, *ierror, *ipntr;
- {
- /* Initialized data */
-
- static struct {
- char e_1[56];
- doublereal e_2;
- } equiv_9 = { {'c', 'l', 'r', 'm', 'e', 'm', ' ', ' ', 'e', 'x', 't',
- 'm', 'e', 'm', ' ', ' ', 'g', 'e', 't', 'm', 'e', 'm', ' ',
- ' ', 'p', 't', 'r', 'm', 'e', 'm', ' ', ' ', 'r', 'e', 'l',
- 'm', 'e', 'm', ' ', ' ', 's', 'e', 't', 'm', 'e', 'm', ' ',
- ' ', 's', 'i', 'z', 'm', 'e', 'm', ' ', ' '}, 0. };
-
- #define errnam ((doublereal *)&equiv_9)
-
-
- /* Format strings */
- static char fmt_201[] = "(\0020memory manager variables nwd4-8-16 incomp\
- atible with nxtevn and nxtmem\002)";
- static char fmt_301[] = "(\0020*error*: memory requirement exceeds mach\
- ine capacity\002,/\0020 memory needs exceed\002,i6)";
- static char fmt_411[] = "(\0020size parameter negative\002)";
- static char fmt_421[] = "(\0020attempt to reallocate existing table\002)";
-
- static char fmt_511[] = "(\0020table pointer invalid\002)";
- static char fmt_531[] = "(\0020attempt to release more than total tabl\
- e\002)";
- static char fmt_901[] = "(\0020*abort*: internal memory manager error a\
- t entry \002,a7)";
-
- /* Builtin functions */
- integer s_wsfe(), e_wsfe(), do_fio();
- /* Subroutine */ int s_stop();
-
- /* Local variables */
- extern /* Subroutine */ int dmpmem_();
-
- /* Fortran I/O blocks */
- static cilist io__2 = { 0, 0, 0, fmt_201, 0 };
- static cilist io__3 = { 0, 0, 0, fmt_301, 0 };
- static cilist io__4 = { 0, 0, 0, fmt_411, 0 };
- static cilist io__5 = { 0, 0, 0, fmt_421, 0 };
- static cilist io__6 = { 0, 0, 0, fmt_511, 0 };
- static cilist io__7 = { 0, 0, 0, fmt_531, 0 };
- static cilist io__8 = { 0, 0, 0, fmt_901, 0 };
-
-
- /* Parameter adjustments */
- --ipntr;
-
- /* Function Body */
- /*< implicit double precision (a-h,o-z) >*/
- /*< dimension ipntr(1) >*/
- /* spice version 2g.6 sccsid=status 3/15/83 */
- /*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
- /*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
- /*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
- /* spice version 2g.6 sccsid=memmgr 3/15/83 */
- /*< common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
- /*< 1 ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
- /*< 2 nwd8,nwd16 >*/
- /*< dimension errnam(7) >*/
- /*< data errnam /6hclrmem,6hextmem,6hgetmem,6hptrmem,6hrelmem, >*/
- /*< 1 6hsetmem,6hsizmem/ >*/
-
- /*< go to (200,410,420,300,510,530),ierror >*/
- switch (*ierror) {
- case 1: goto L200;
- case 2: goto L410;
- case 3: goto L420;
- case 4: goto L300;
- case 5: goto L510;
- case 6: goto L530;
- }
-
- /* *** error(s) found *** */
-
- /* .. nxtevn and/or nxtmem incompatible with nwd4, nwd8, and nwd16 */
-
- /*< 200 write(iofile,201) >*/
- L200:
- io__2.ciunit = status_1.iofile;
- s_wsfe(&io__2);
- e_wsfe();
- /*< 201 format('0memory manager variables nwd4-8-16 incompatible with nxte >*/
- /*< 1vn and nxtmem') >*/
- /*< go to 900 >*/
- goto L900;
-
- /* ... memory needs exceed maximum available space */
- /*< 300 write (iofile,301) maxmem >*/
- L300:
- io__3.ciunit = status_1.iofile;
- s_wsfe(&io__3);
- do_fio(&c__1, (char *)&memmgr_1.maxmem, (ftnlen)sizeof(integer));
- e_wsfe();
- /*< 301 format('0*error*: memory requirement exceeds machine capacity', >*/
- /*< 1/'0 memory needs exceed',i6) >*/
- /*< go to 900 >*/
- goto L900;
- /* ... *isize* < 0 */
- /*< 410 write(iofile,411) >*/
- L410:
- io__4.ciunit = status_1.iofile;
- s_wsfe(&io__4);
- e_wsfe();
- /*< 411 format('0size parameter negative') >*/
- /*< go to 900 >*/
- goto L900;
- /* ... getmem: attempt to reallocate existing block */
- /*< 420 write(iofile,421) >*/
- L420:
- io__5.ciunit = status_1.iofile;
- s_wsfe(&io__5);
- e_wsfe();
- /*< 421 format('0attempt to reallocate existing table') >*/
- /*< go to 900 >*/
- goto L900;
- /* ... *ipntr* invalid */
- /*< 510 write(iofile,511) >*/
- L510:
- io__6.ciunit = status_1.iofile;
- s_wsfe(&io__6);
- e_wsfe();
- /*< 511 format('0table pointer invalid') >*/
- /*< go to 900 >*/
- goto L900;
- /* ... relmem: *isize* larger than indicated block */
- /*< 530 write(iofile,531) >*/
- L530:
- io__7.ciunit = status_1.iofile;
- s_wsfe(&io__7);
- e_wsfe();
- /*< 531 format('0attempt to release more than total table') >*/
- /* ... issue error message */
- /*< 900 write (iofile,901) errnam(inam) >*/
- L900:
- io__8.ciunit = status_1.iofile;
- s_wsfe(&io__8);
- do_fio(&c__1, (char *)&errnam[*inam - 1], (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< 901 format('0*abort*: internal memory manager error at entry ', >*/
- /*< 1 a7) >*/
- /*< 950 call dmpmem(ipntr(1)) >*/
- /* L950: */
- dmpmem_(&ipntr[1]);
- /*< 1000 stop >*/
- /* L1000: */
- s_stop("", 0L);
- /*< end >*/
- } /* errmem_ */
-
- #undef errnam
-
-
-